home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / DATABASE / S9303.ZIP;1 / RUBEL.ZIP / PASSWORD.PRG next >
Encoding:
Text File  |  1993-02-10  |  1.2 KB  |  72 lines
  1. PASSWORD Function
  2.  
  3. FUNCTION password
  4. PARAMETERS pw_len
  5. PRIVATE pass_str, p_key, cur_curs, cur_win
  6.  
  7. pw_len = IIF(pcount() = 0, 6, pw_len)
  8. cur_win = window()
  9. pass_str = ''
  10. p_key = 0
  11.  
  12. cur_curs = SET('cursor') = 'ON'
  13. SET CURSOR on
  14.  
  15. DEFINE WINDOW pass_win FROM 09,18 ;
  16.                        TO 15,58 DOUBLE
  17. ACTIVATE WINDOW pass_win
  18.  
  19. @ 01,09 SAY 'Type in your password'
  20. @ 02,12 SAY '(' + LTRIM(STR(pw_len)) + ;
  21.             ' characters.)'
  22. @ 04,15 SAY ''
  23.  
  24. ***  accept data
  25.  
  26. DO WHILE p_key # 13     &&  accept until Enter
  27.   p_key = 0
  28.  
  29.   DO WHILE p_key = 0    &&  allows for OKLs & help
  30.     p_key = INKEY()
  31.   ENDDO
  32.  
  33.   DO CASE
  34.  
  35.     CASE ISALPHA(chr(p_key)) .or. ;
  36.          (p_key >= 32 .and. p_key <= 64)
  37.       pass_str = pass_str + CHR(p_key)
  38.  
  39. ***  keys to delete a character
  40.  
  41.     CASE p_key = 19 .or. p_key = 127 .or. ;
  42.          p_key = 7
  43.       pass_str = LEFT(pass_str,LEN(pass_str)-1)
  44.  
  45.   ENDCASE
  46.  
  47. ***  are we at maximum string length?
  48.  
  49.   IF LEN(pass_str) >= pw_len
  50.     EXIT
  51.   ENDIF
  52.  
  53.   @ 04,15 SAY SPACE(pw_len)
  54.   @ 04,15 SAY REPLICATE('*',LEN(pass_str))
  55. ENDDO
  56.  
  57. RELEASE WINDOW pass_win
  58.  
  59. IF ISBLANK(cur_win)
  60.   ACTIVATE SCREEN
  61. ENDIF
  62.  
  63. IF .not. cur_curs
  64.   SET CURSOR OFF
  65. ENDIF
  66.  
  67. RETURN(pass_str)
  68.  
  69. ******
  70.  
  71.  
  72.